home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / CHKSMOK.SRC < prev    next >
Text File  |  1990-11-03  |  27KB  |  1,082 lines
  1. ;\|
  2. ;CHKSMOK.SRC     Translated from CHKSMOK.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;CHECK_UP 00:02:53 AM   3/ 5/90   |
  4. DO_DEFINES:
  5.     define(CTR2|N|1||)
  6.     define(ISITCLIN|A|1||)
  7.     define(silly|a|1||)
  8.     define(fld_lctr|N|2||)
  9.     define(CTR6|N|2||)
  10.     define(FLAG|A|1||)
  11.     define(YES.NO|A|1||)
  12.     define(MEM_FEV_PC|N|5|2|)
  13.     define(CTR3|N|1||)
  14.     define(MEM_NAME_CHK|A|27||)
  15.     define(PROC4|A|1||)
  16.     define(REF_CTR|N|2||)
  17.     define(MEM_DOC2|N|1||)
  18.     define(CON_CTR|N|2||)
  19.     define(EXTRAS|N|3||)
  20.     define(CON_NUM|N|3||)
  21.     define(CLIN_NUM|N|3||)
  22.     define(EMERG_NUM|N|3||)
  23.     define(ISIT_EMER|A|1||)
  24.     define(MEM_FEV|N|5|2|)
  25.     define(MEM_DOC|A|1||)
  26.     define(NY|A|1||)
  27.     define(AGE|N|2||)
  28.     define(BP_DROP|N|2||)
  29.     define(MEM_CTR|N|1||)
  30.     define(FBS_ADD|N|5|2|)
  31.     define(MEM_BP_AGE|N|3||)
  32.     define(AOD|A|1||15)
  33.     define(TD|S|8||)
  34.     define(MN|A|30||15)
  35.     define(DO|A|8||15)
  36.     define(QU|A|10||15)
  37.     define(DS|A|30||15)
  38.     define(QTY|N|3||15)
  39.     define(ISN|N|3||15)
  40.     define(CTR|N|2||)
  41.     define(CTR2|N|2||)
  42.     define(LNE.LNGTH|N|2||)
  43.     define(OK|A|1||)
  44.     define(LNE.LN2|N|2||)
  45.     define(NUM.MSG|N|2||)
  46.     define(MESSAGE|A|78||15)
  47.     define(ENT.MASK|A|10||)
  48.     define(LLC|N|2||)
  49.     define(WD|N|2||)
  50.     define(HT|N|2||)
  51.     define(MCNTR|N|5||)
  52.     define(MCNTR2|N|5||)
  53.     define(MCNTR3|N|5||)
  54.     define(MCNTR4|N|5||)
  55.     define(MEM_DIAB|A|1||)
  56.     define(MEM_NEW|A|1||)
  57.     define(MEM_BP|A|1||)
  58.     define(MEM_THY|A|1||)
  59.     define(MEM_OLD|A|1||)
  60.     define(MEM_RECD|S|8||)
  61.     define(MEM_RECT|S|8||)
  62.     define(MEM_RECB|S|8||)
  63. OPEN_FILES:
  64.     open(PATIENT||0|EXIT)
  65.     open(DIABETIC||1|EXIT)
  66.     open(RP||0|)
  67.     open(RECALLS||0|)
  68.     open(REFER||0|EXIT)
  69.     open(PROCEDE||1|EXIT)
  70.     open(MEMORY||0|EXIT)
  71.     open(GPSETUP||0|EXIT)
  72. STARTCHK:
  73.     trap(S|G|SAVE_RECS)
  74.     trap(D|I)
  75.     trap(C|G|CLR_RECS)
  76.     trap(Q|G|EXIT)
  77.     trap(J|I)
  78. MOUNT_SCRS:
  79.     mount(SCREEN2|S||)
  80.     date(TD|G)
  81. START_UP:
  82.     trap(J|I)
  83.     MEM_BP = ("Y")
  84. PAT.NAME:
  85.     clrlne(1|22)
  86.     enter(PATIENT.NAME||||||||)
  87.     find(G|PATIENT.NAME|PAT.NAME|)
  88.     DIAB_REF = (RECORD.NUMBER)
  89.     find(M|DIAB_REF|NO_DIABX|)
  90. NO_DIAB:
  91.     goto STARTALL
  92. NO_DIAB2:
  93.     gosub GET_AGE
  94.     trap(%|I)
  95.     trap(U|I)
  96.     saves(10)
  97.     window(20|12|2|35)
  98.     ISITCLIN = ("")
  99.     pmsg("Is this a clinic or update?"|1|1|N|N|S|)
  100.     enter(ISITCLIN|"YN"|||Y|Y|N|30|1|N)
  101.     if ISITCLIN = ("Y") then CHECK_DATE = (TD)
  102.     trap(%|D)
  103.     trap(U|D)
  104.     redsp(10)
  105.     enter(CHECK_DATE||||N|Y|N|||N)
  106.     enter(CHECK_OP||||Y|Y|N|||N)
  107.     if CHECK_OP = ("") reent
  108.     enter(CHK_DOC|"1234"|||N|Y|N|||N)
  109.     enter(DOC_BP1|"1234567890"|||N|Y|N|||N)
  110.     enter(DOC_BP2|"1234567890"|||N|Y|N|||N)
  111.     if DOC_BP1 > (0) then MEM_BP = ("Y")
  112. NO_DIAB3:
  113.     FLAG = ("X")
  114.     trap(J|G|RUN_MEMO)
  115.     enter(SMOK||SMOK_HLP||N|Y|N|||N)
  116.     if SMOK > (0) gosub SMOK_MSG
  117.     enter(EXERCISE||EX_HLP||N|Y|N|||N)
  118.     enter(ALCOHOL||ALC_HLP||N|Y|N|||N)
  119.     enter(ANGINA||ANG_HLP||N|Y|N|||N)
  120.     enter(DIET|"GB "|DIET_HLP||Y|Y|N|||N)
  121.     enter(WT1||||N|Y|N|||N)
  122.     enter(WT2||||N|Y|N|||N)
  123.     IDEAL_WT = (WT2-81*0.85)
  124.     if WT1 > (IDEAL_WT) gosub WEIGHT
  125.     enter(PROT|" T+"|||N|N|N|||N)
  126.     if PROT => ("+") gosub REF_PROT
  127.     enter(SUG||SUG_HLP||N|N|N|||N)
  128.     if SUG > (0.25) gosub REF_SUG
  129.     enter(BP_CHECK_NUM|" 123"|||N|Y|N|||N)
  130.     enter(BP1||||N|Y|N|||N)
  131.     enter(BP2||||N|Y|N|||N)
  132.     enter(BP1S||BPST_HLP||N|Y|N|||N)
  133.     gosub BP_CHECK
  134.     enter(PULSE||||N|Y|N|||N)
  135.     if PULSE > (120) gosub FAST
  136.     if PULSE < (56) gosub SLOW
  137.     enter(REG|" YN"|REG_HLP||Y|Y|N|||N)
  138.     if REG = ("N") then enter(APEX||||N|Y|N|||N)
  139.     if APEX <> (0) then if APEX > (120) gosub FAST
  140.     if APEX <> (0) then if APEX < (56) gosub SLOW
  141.     enter(SUGAR||FEV_HLP||N|Y|N|||N)
  142.     enter(FEV||FEV_HLP||N|Y|N|||N)
  143.     MEM_FEV_PC = (FEV/SUGAR*100)
  144.     if MEM_FEV_PC => (80) then DRUG_TYPE = (1)
  145.     if MEM_FEV_PC < (80) then DRUG_TYPE = (2)
  146.     if MEM_FEV_PC < (50) then DRUG_TYPE = (3)
  147.     if MEM_FEV_PC < (30) do
  148.         {
  149.         REF_CHECK = ("Y")
  150.         DRUG_TYPE = (4)
  151.         }
  152.     enter(CHOL||||N|Y|N|||N)
  153.     enter(COMMENT1||||Y|Y|N|||N)
  154.     enter(COMMENT2||||Y|Y|N|||N)
  155.     enter(REF_CHECK|"NY"|||Y|Y|N|||N)
  156.     NEXT_CHECK = (CHECK_DATE+186)
  157.     enter(NEXT_CHECK||||N|Y|N|||N)
  158.     YES.NO = ("")
  159.     enter(YES.NO|"YN"|||Y|Y|N|||N)
  160.     if YES.NO = ("Y") gosub PRINT
  161. SAVE_RECS:
  162.     if RECORD.NUMBER = (0) goto PAT.NAME
  163.     pmsg("SAVE RECORD Y/N:"|30|22|N|N|S|)
  164.     enter(YES.NO|"YN"|||Y|Y|N|50|22|N)
  165.     if YES.NO <> ("Y") goto PAT.NAME
  166.     clrlne(1|22)
  167. SAVE_DONE:
  168.     DIAB_REF = (RECORD.NUMBER)
  169.     CHECK_TYPE = (11)
  170.     save(DIABETIC|N|Y)
  171.     find(M|RECORD.NUMBER|EXIT|)
  172.     save(PATIENT|N|Y)
  173.     if FLAG = ("Y") then run("recmenu")
  174.     FLAG = ("")
  175. STARTX:
  176.     MEM_DIAB = ("")
  177.     MEM_NEW = ("")
  178.     MEM_BP = ("")
  179.     MEM_THY = ("")
  180.     MEM_CTR = (0)
  181.     MEM_RECD = (0)
  182.     MEM_NAME_CHK = ("")
  183.     MEM_RECT = (0)
  184.     MEM_CTR = (0)
  185.     MEM_OLD = ("")
  186.     MEM_RECB = (0)
  187.     AGE = (0)
  188.     BP_DROP = (0)
  189.     FBS_ADD = (0)
  190.     MEM_BP_AGE = (0)
  191.     for(CTR|12|23|1)
  192.         {
  193.         clrlne(1|CTR)
  194.         }
  195.     pmsg("F1 - Help  F2 - Memo  [Ctrl-Y]- Print"|1|24|N|N|S|)
  196.     clr(PATIENT|B)
  197.     goto START_UP
  198. DEL_RECS:
  199.     del(DIABETIC|Y|)
  200.     clr(PATIENT|B)
  201.     goto STARTX
  202. CLR_RECS:
  203.     clr(PATIENT|B)
  204.     clr(DIABETIC|B)
  205.     goto STARTX
  206. EXIT:
  207.     if FLAG = ("X") do
  208.         {
  209.         FLAG = ("Y")
  210.         goto SAVE_DONE
  211.         }
  212.     run("recmenu")
  213. PRT.MSG:
  214.     LNE.LNGTH = (0)
  215.     for(MCNTR|1|NUM.MSG|1)
  216.         {
  217.         LNE.LN2 =siz(A|MESSAGE[MCNTR])
  218.         if LNE.LN2 > (LNE.LNGTH) then LNE.LNGTH = (LNE.LN2)
  219.         }
  220.     NUM.MSG = (NUM.MSG + 1)
  221.     if LNE.LNGTH < (26) then LNE.LNGTH = (26)
  222.     LNE.LNGTH = (LNE.LNGTH + 4)
  223.     LLC = (40 - (LNE.LNGTH / 2))
  224.     HT = (NUM.MSG + 3)
  225.     WD = (LNE.LNGTH + 1)
  226.     saves(1)
  227.     window(LLC|24|HT|WD)
  228.     NUM.MSG = (NUM.MSG - 1)
  229.     pmsg(""||||||)
  230.     for(MCNTR|1|NUM.MSG|1)
  231.         {
  232.         pmsg(MESSAGE[MCNTR]|3||N|N|S|)
  233.         }
  234.     pmsg("Press any key to continue"|3||Y|N|S|)
  235.     redsp(1)
  236.     ret
  237. NO_DIABX:
  238.     clr(DIABETIC|B)
  239.     MESSAGE[1] = ("NO CHECK UP RECORD FOR THIS PATIENT")
  240.     NUM.MSG = (1)
  241.     gosub PRT.MSG
  242.     goto NO_DIAB
  243. SEEALL:
  244. STARTALL1:
  245. STARTALL:
  246.     if RECORD.NUMBER = (0) goto ENDIT
  247.     COD.REF = (RECORD.NUMBER)
  248.     find(M|COD.REF|NEXTALL2|)
  249.     MEM_RECB = (COD.D[9])
  250. NEXTALL2:
  251.     RP.REF = (RECORD.NUMBER)
  252.     find(M|RP.REF|ENDITX|)
  253.     CTR = (1)
  254. TESTALL:
  255.     if CTR = (12) goto ENDIT
  256.     AOD[CTR] = (AUTO.ON.DEMAND)
  257.     MN[CTR] = (MEDICATION)
  258.     DO[CTR] = (DOSE)
  259.     QU[CTR] = (QUANTITY)
  260.     DS[CTR] = (DIRECTIONS)
  261.     QTY[CTR] = (RP.DISP.QTY)
  262.     ISN[CTR] = (ISSUE.NO)
  263.     trim(MN[CTR]|T)
  264.     trim(QU[CTR]|T)
  265.     just(QU[CTR]|L)
  266.     trim(DO[CTR]|T)
  267.     just(DO[CTR]|L)
  268.     trim(DS[CTR]|T)
  269.     just(DS[CTR]|L)
  270.     CTR2 = (CTR+11)
  271.     pmsg(AOD[CTR];" ";MN[CTR];" ";DO[CTR];" ";QU[CTR];" ";DS[CTR];" ";QTY[CTR];" ";ISN[CTR]|1|CTR2|N|N|S|)
  272.     silly = ("")
  273.     find(N|RP|ENDIT|)
  274.     if RP.REF <> (RECORD.NUMBER) goto ENDIT
  275.     CTR = (CTR+1)
  276.     goto TESTALL
  277. CLEARXALL:
  278.     clr(RP|B)
  279.     clr(RECALLS|B)
  280.     clrmem(AOD|15)
  281.     clrmem(MN|15)
  282.     clrmem(DO|15)
  283.     clrmem(QU|15)
  284.     clrmem(DS|15)
  285.     clrmem(QTY|15)
  286.     clrmem(ISN|15)
  287.     ret
  288. ENDIT:
  289.     find(M|RECORD.NUMBER|PAT.NAME|)
  290.     DIAB_REF = (RECORD.NUMBER)
  291.     find(M|DIAB_REF|NO_DIAB2|)
  292.     goto NO_DIAB2
  293. ENDITX:
  294.     MESSAGE[1] = ("NO DRUGS ON REPEAT")
  295.     NUM.MSG = (1)
  296.     gosub PRT.MSG
  297.     goto ENDIT
  298. GET_AGE:
  299.     AGE = (TD-DATE.OF.BIRTH/365)
  300.     ret
  301. BP_CHECK:
  302.     if MEM_BP = ("Y") do
  303.         {
  304.         if BP_CHECK_NUM => (2) do
  305.             {
  306.             if BP1 > (DOC_BP1) gosub REFER_BP
  307.             if BP2 > (DOC_BP2) gosub REFER_BP
  308.             BP_DROP = (BP1-BP1S)
  309.             if BP_DROP > (20) gosub REFER_BP
  310.             }
  311.         ret
  312.         }
  313.     else
  314.         {
  315.         if BP_CHECK_NUM = (2) do
  316.             {
  317.             if BP1 > (AGE+110) gosub REFER_BP
  318.             }
  319.         if BP2 > (105) gosub REFER_BP
  320.         BP_DROP = (BP1-BP1S)
  321.         if BP_DROP > (20) gosub REFER_BP
  322.         }
  323.     ret
  324. REF_FBS:
  325.     if FBS_CHECK_NUM = (2) do
  326.         {
  327.         FBS_ADD = (FBS+FBS2)
  328.         if FBS_ADD > (14) gosub FBS_MSG
  329.         }
  330.     ret
  331. REF_HBA:
  332.     if HBA > (8) gosub HBA_MSG
  333.     ret
  334. SMOK_HLP:
  335.     MESSAGE[1] = ("Number per day eg 16")
  336.     NUM.MSG = (1)
  337.     gosub PRT.MSG
  338.     ret
  339. SMOK_MSG:
  340.     MESSAGE[1] = ("There is a risk of cancer,heart disease,gangrene,and bronchitis")
  341.     NUM.MSG = (1)
  342.     gosub PRT.MSG
  343.     ret
  344. REF_PROT:
  345.     MESSAGE[1] = ("If there is more than a trace -send sample for orgs and sens.")
  346.     MESSAGE[2] = ("Refer to Dr if protein persists etc")
  347.     NUM.MSG = (2)
  348.     gosub PRT.MSG
  349.     ret
  350. SUG_HLP:
  351.     MESSAGE[1] = ("Enter sugar in urine as a decimal eg 1/4 = .25")
  352.     NUM.MSG = (1)
  353.     gosub PRT.MSG
  354.     ret
  355. REF_SUG:
  356.     MESSAGE[1] = ("Do a blood sugar.If high refer to Dr.")
  357.     MESSAGE[2] = ("If patient is a diabetic refer to Dr if more than a third of tests over .25")
  358.     NUM.MSG = (2)
  359.     gosub PRT.MSG
  360.     ret
  361. REG_HLP:
  362.     MESSAGE[1] = ("Enter a Y if regular or a N if not. Do apical rate if N")
  363.     NUM.MSG = (1)
  364.     gosub PRT.MSG
  365.     ret
  366. REFER_BP:
  367.     MESSAGE[1] = ("There is a definate BP problem here - refer to Dr.")
  368.     NUM.MSG = (1)
  369.     REF_CHECK = ("Y")
  370.     gosub PRT.MSG
  371.     ret
  372. BPST_HLP:
  373.     MESSAGE[1] = ("Enter standing systolic - It should not drop more than 20")
  374.     NUM.MSG = (1)
  375.     gosub PRT.MSG
  376.     ret
  377. DIET_HLP:
  378.     MESSAGE[1] = ("G = Good diet B = Bad diet ")
  379.     NUM.MSG = (1)
  380.     gosub PRT.MSG
  381.     ret
  382. EX_HLP:
  383.     MESSAGE[1] = ("Enter a number for hours per week exercise")
  384.     NUM.MSG = (1)
  385.     gosub PRT.MSG
  386.     ret
  387. FBS_MSG:
  388.     MESSAGE[1] = ("These are too high - refer to Dr.")
  389.     NUM.MSG = (1)
  390.     gosub PRT.MSG
  391.     REF_CHECK = ("Y")
  392.     ret
  393. HBA_MSG:
  394.     MESSAGE[1] = ("Poor control here - refer to Dr.")
  395.     NUM.MSG = (1)
  396.     gosub PRT.MSG
  397.     REF_CHECK = ("Y")
  398.     ret
  399. VIS_HLP:
  400.     MESSAGE[1] = ("Use Snellen test type eg 6 ")
  401.     NUM.MSG = (1)
  402.     gosub PRT.MSG
  403.     ret
  404. RET_HLP:
  405.     MESSAGE[1] = ("Retinopathy 0,1,2,3,4,5 ")
  406.     NUM.MSG = (1)
  407.     gosub PRT.MSG
  408.     ret
  409. FOOT_HLP:
  410.     MESSAGE[1] = ("Y = Pulses present N = No pulses")
  411.     NUM.MSG = (1)
  412.     gosub PRT.MSG
  413.     ret
  414. SENS_HLP:
  415.     MESSAGE[1] = ("Y = Tuning fork sensation present N = Not present")
  416.     NUM.MSG = (1)
  417.     gosub PRT.MSG
  418.     ret
  419. DRUGSCH:
  420.     MESSAGE[1] = ("NOW CHECK PATIENTS DRUG THERAPY IS CORRECT")
  421.     NUM.MSG = (1)
  422.     gosub PRT.MSG
  423.     mount(DRUGSCR|S)
  424.     RP.REF = (RECORD.NUMBER)
  425.     find(M|RP.REF|NOSCR|)
  426.     CTR = (17)
  427. NEXTRPS:
  428.     trim(MEDICATION|T)
  429.     if CTR = (29) do
  430.         {
  431.         pmsg("There are more drugs"|65|20|N|N|D|)
  432.         goto NOSCR
  433.         }
  434.     if CTR => (23) do
  435.         {
  436.         CTR6 = (CTR-6)
  437.         pmsg(MEDICATION|31|CTR6|N|N|D|)
  438.         }
  439.     else
  440.         {
  441.         pmsg(MEDICATION|1|CTR|N|N|D|)
  442.         }
  443.     CTR = (CTR+1)
  444.     find(N|RP|NOSCR|)
  445.     if RP.REF <> (RECORD.NUMBER) goto NOSCR
  446.     goto NEXTRPS
  447. NOSCR:
  448.     enter(COMMENT1|||NOSCR|Y|Y|N|||N)
  449.     enter(COMMENT2||||Y|Y|N|||N)
  450.     mount(SCREEN2|S)
  451.     ret
  452. NOCOD:
  453.     COD.PAT.NAME = (PATIENT.NAME)
  454.     COD.REF = (RECORD.NUMBER)
  455.     save(RECALLS|N|N)
  456.     find(M|COD.REF||)
  457.     goto SAVE_RECS
  458. RUN_MEMO:
  459.     goto RUN_MEMOX
  460. RUN_MEMOX:
  461.     trap(J|G|EXIT_MEM)
  462.     trap(S|G|SAVE_MEMO)
  463.     trap(D|I)
  464.     trap(C|I)
  465.     trap(Q|G|EXIT_MEM)
  466.     trap(L|G|EXIT_MEM)
  467. MOUNT:
  468.     mount(NEW|S||)
  469. START:
  470.     enter(PATIENT.NAME||||Y|Y|N|||N)
  471.     find(G|PATIENT.NAME|START|)
  472.     PROC_REF = (RECORD.NUMBER)
  473.     find(M|PROC_REF|START2CL|)
  474.     NY = ("")
  475.     pmsg("DO YOU WANT TO UPDATE THE MEMOS FIRST:"|10|20|N|N|S|)
  476.     enter(NY|"YN"|||Y|Y|N|50|20|N)
  477.     if NY = ("Y") goto UPMEMO
  478.     clrlne(1|20)
  479. START2:
  480.     gosub LINE
  481.     if CTR2 = (0) then CTR2 = (1)
  482. SATRT3:
  483.     MEM_DOC = ("")
  484.     for(CTR|CTR2|6|1)
  485.         {
  486.         PROC_DATE[CTR] = (TD)
  487.         PROC_UP = (TD)
  488.         enter(PROC_DATE[CTR]|||SATRT3|N|N|N|||N)
  489.         enter(PROC[CTR]||||Y|Y|N|||N)
  490.         enter(PROC_DOC[CTR]|"12345"|||Y|Y|N|||N)
  491.         MEM_DOC = (PROC_DOC[CTR])
  492.         enter(PROC_OP[CTR]||||Y|Y|N|||N)
  493.         if PROC_OP[CTR] = ("") reent
  494.         if PROC_EX[CTR] = ("") do
  495.             {
  496.             PROC_REF = (RECORD.NUMBER)
  497.             PROC4 =mid(PROC[CTR]|1|1|)
  498.             if PROC4 = ("*") do
  499.                 {
  500.                 PROC_EX[CTR] = ("X")
  501.                 gosub STARTAGAIN
  502.                 save(PROCEDE|N|N)
  503.                 find(M|PROC_REF||)
  504.                 }
  505.             enter(PROC_DONE[1]|" YNSCRO"|||Y|Y|N|||N)
  506.             enter(PROC_DONE[2]|" YNSCRO"|||Y|Y|N|||N)
  507.             enter(PROC_DONE[3]|" YNSCRO"|||Y|Y|N|||N)
  508.             enter(PROC_DONE[4]|" YNSCRO"|||Y|Y|N|||N)
  509.             enter(PROC_DONE[5]|" YNSCRO"|||Y|Y|N|||N)
  510.             enter(PROC_DONE[6]|" YNSCRO"|||Y|Y|N|||N)
  511.             }
  512.         }
  513.     gosub LINE
  514.     for(CTR|1|6|1)
  515.         {
  516.         if PROC[CTR] = ("") then PROC_DATE[CTR] = (0)
  517.         }
  518.     goto SATRT3
  519. SAVE_MEMO:
  520.     for(CTR|1|6|1)
  521.         {
  522.         if PROC[1] = ("") do
  523.             {
  524.             clr(PROCEDE|B)
  525.             goto START
  526.             }
  527.         if PROC[CTR] = ("") do
  528.             {
  529.             PROC_DATE[CTR] = (0)
  530.             PROC_OP[CTR] = ("")
  531.             PROC_DOC[CTR] = ("")
  532.             PROC_DONE[CTR] = ("")
  533.             }
  534.         }
  535.     if PROC_REF = (0) goto START
  536.     PROC_REF = (RECORD.NUMBER)
  537.     if PROC_REF = (0) goto START
  538.     save(PROCEDE|Y|Y|)
  539.     MEM_DOC = ("")
  540.     goto START
  541. EXIT_MEM:
  542.     if PROC[1] = ("") goto RUNPATREC
  543.     for(CTR|1|6|1)
  544.         {
  545.         if PROC[CTR] = ("") do
  546.             {
  547.             PROC_DATE[CTR] = (0)
  548.             PROC_OP[CTR] = ("")
  549.             PROC_DOC[CTR] = ("")
  550.             PROC_DONE[CTR] = ("")
  551.             }
  552.         }
  553.     if PROC_REF > (0) then save(PROCEDE|N|Y)
  554. RUNPATREC:
  555.     trap(S|G|SAVE_RECS)
  556.     trap(D|I)
  557.     trap(C|G|CLR_RECS)
  558.     trap(Q|G|EXIT)
  559.     trap(J|G|RUN_MEMO)
  560.     mount(SCREEN2|S)
  561.     gosub STARTALLXX
  562.     goto PAT.NAME2
  563. LINE:
  564.     for(CTR2|1|6|1)
  565.         {
  566.         if PROC[CTR2] = ("") do
  567.             {
  568.             if CTR2 = (6) do
  569.                 {
  570.                 pops
  571.                 goto SATRT3
  572.                 }
  573.             ret
  574.             }
  575.         }
  576.     CTR = (2)
  577.     if PROC_DATE[1] = (TD) do
  578.         {
  579.         for(CTR3|1|6|1)
  580.             {
  581.             enter(PROC_DONE[CTR3]|" Y"|||Y|Y|N|||N)
  582.             }
  583.         pops
  584.         goto SAVE_MEMO
  585.         }
  586.     for(CTR2|1|5|1)
  587.         {
  588.         PROC[CTR2] = (PROC[CTR])
  589.         PROC_DATE[CTR2] = (PROC_DATE[CTR])
  590.         PROC_OP[CTR2] = (PROC_OP[CTR])
  591.         PROC_DOC[CTR2] = (PROC_DOC[CTR])
  592.         PROC_DONE[CTR2] = (PROC_DONE[CTR])
  593.         CTR = (CTR+1)
  594.         }
  595.     PROC[6] = ("")
  596.     PROC_DATE[6] = (0)
  597.     PROC_OP[6] = ("")
  598.     PROC_DOC[6] = ("")
  599.     PROC_DONE[6] = ("")
  600.     PROC_EX[6] = ("")
  601.     goto LINE
  602.     ret
  603. UPARROW:
  604.     CTR2 = (CTR2-1)
  605.     CTR = (CTR2)
  606.     ret
  607. STARTAGAIN:
  608.     trap(%|I)
  609.     trap(J|I)
  610.     trap(Q|G|EXITX)
  611.     trap(U|I)
  612.     trap(C|I)
  613.     trap(S|I)
  614.     saves(1)
  615.     window(20|15|5|40)
  616.     trap(Q|G|EXITX)
  617.     find(B|HEADING||)
  618.     pmsg("IS IT EMERGENCY:"|1|1|N|N|S|)
  619.     enter(ISIT_EMER|"YN"|||Y|Y|N|20|1|N)
  620.     if ISIT_EMER = ("Y") goto SCR2
  621.     gosub SCREEN2
  622.     CLIN_NUM = (CLIN_NUM)
  623.     pmsg("ENTER SPECIALTY:"|1|2|N|N|S|)
  624.     enter(CLIN_NUM||||N|Y|N|20|2|N)
  625. ADDER:
  626.     REF_COD = (MEM_DOC)
  627.     find(M|REF_COD|EXIT|)
  628.     if ISIT_EMER <> ("Y") do
  629.         {
  630.         CLIN_REF[CLIN_NUM] = (CLIN_REF[CLIN_NUM]+1)
  631.         }
  632.     else
  633.         {
  634.         EMERG_REF[EMERG_NUM] = (EMERG_REF[EMERG_NUM]+1)
  635.         }
  636.     save(REFER|N|Y)
  637.     CLIN_NUM = (0)
  638.     CON_NUM = (0)
  639.     EMERG_NUM = (0)
  640.     ISIT_EMER = ("")1
  641.     redsp(1)
  642.     trap(%|D)
  643.     trap(J|G|EXIT_MEM)
  644.     trap(U|D)
  645.     trap(Q|G|EXIT)
  646.     ret
  647. SCREEN2:
  648.     saves(2)
  649.     window(1|25|24|78)
  650.     for(REF_CTR|1|22|1)
  651.         {
  652.         pmsg(@R;REF_CTR;@N;" ";@R;CLINICS[REF_CTR];@N|1|REF_CTR|N|N|S|)
  653.         }
  654.     CON_CTR = (REF_CTR+1)
  655.     for(REF_CTR|1|22|1)
  656.         {
  657.         pmsg(@R;CON_CTR;@N;" ";@R;CLINICS[CON_CTR];@N|25|REF_CTR|N|N|S|)
  658.         CON_CTR = (CON_CTR+1)
  659.         }
  660.     pmsg("ENTER NUMBER:"|60|12|N|N|S|)
  661.     enter(CLIN_NUM||||N|Y|N|65|13|N)
  662.     if CLIN_NUM = (0) reent
  663.     if CLIN_NUM > (44) reent
  664.     redsp(2)
  665.     ret
  666. SCREEN3:
  667.     saves(2)
  668.     window(1|25|24|78)
  669.     for(REF_CTR|1|22|1)
  670.         {
  671.         pmsg(@R;REF_CTR;@N;" ";@R;CLINICS[REF_CTR];@N|1|REF_CTR|N|N|S|)
  672.         }
  673.     CON_CTR = (REF_CTR+1)
  674.     for(REF_CTR|1|22|1)
  675.         {
  676.         pmsg(@R;CON_CTR;@N;" ";@R;CLINICS[CON_CTR];@N|25|REF_CTR|N|N|S|)
  677.         CON_CTR = (CON_CTR+1)
  678.         }
  679.     pmsg("ENTER NUMBER:"|60|12|N|N|S|)
  680.     enter(EMERG_NUM||||N|Y|N|65|13|N)
  681.     if EMERG_NUM = (0) reent
  682.     if EMERG_NUM > (44) reent
  683.     redsp(2)
  684.     ret
  685. SCR2:
  686.     gosub SCREEN3
  687.     EMERG_NUM = (EMERG_NUM)
  688.     pmsg("ENTER SPECIALTY EMERGENCY:"|1|3|N|N|S|)
  689.     enter(EMERG_NUM||||N|Y|N|30|3|N)
  690.     goto ADDER
  691. EXITX:
  692.     goto STARTCHK
  693. UPMEMO:
  694.     enter(PROC_DONE[1]|" YNSCRO"|||Y|Y|N|||N)
  695.     enter(PROC_DONE[2]|" YNSCRO"|||Y|Y|N|||N)
  696.     enter(PROC_DONE[3]|" YNSCRO"|||Y|Y|N|||N)
  697.     enter(PROC_DONE[4]|" YNSCRO"|||Y|Y|N|||N)
  698.     enter(PROC_DONE[5]|" YNSCRO"|||Y|Y|N|||N)
  699.     enter(PROC_DONE[6]|" YNSCRO"|||Y|Y|N|||N)
  700.     clrlne(1|22)
  701.     goto START2
  702. START2CL:
  703.     clr(PROCEDE|B)
  704.     goto START2
  705. PAT.NAME2:
  706.     goto NO_DIAB3
  707. PRINT:
  708.     mount(CHKREP|R|P)
  709.     pset(128|24|24)
  710.     pchr(P|1)
  711.     pfmt(1|||N|N|)
  712.     pfmt(2|||N|N|)
  713.     pfmt(3|||N|N|)
  714.     pfmt(4|||N|N|)
  715.     pfmt(5|||N|N|)
  716.     pfmt(6|||N|N|)
  717.     pfmt(7|||N|N|)
  718.     fld_lctr = (0)
  719.     gosub PRINTRP
  720.     fld_lctr = (fld_lctr+7)
  721.     if REF_CHECK = ("Y") do
  722.         {
  723.         pmsg(%14;"                          REFERRED TO DOCTOR"|||N|N|P|)
  724.         fld_lctr = (fld_lctr+1)
  725.         }
  726.     CTR3 = (24-fld_lctr)
  727.     if CTR3 <= (0) goto MOUNTAGAIN
  728.     for(CTR2|1|CTR3|1)
  729.         {
  730.         pmsg(""|||N|N|P|)
  731.         }
  732. MOUNTAGAIN:
  733.     mount(SCREEN2|S)
  734.     gosub STARTALLXX
  735.     ret
  736. PRINTRP:
  737.     RP.REF = (RECORD.NUMBER)
  738.     find(M|RP.REF|RETPRINT|)
  739.     CTR = (1)
  740. TESTALLX:
  741.     fld_lctr = (fld_lctr+1)
  742.     if CTR = (8) goto RETPRINT
  743.     AOD[CTR] = (AUTO.ON.DEMAND)
  744.     MN[CTR] = (MEDICATION)
  745.     DO[CTR] = (DOSE)
  746.     QU[CTR] = (QUANTITY)
  747.     DS[CTR] = (DIRECTIONS)
  748.     QTY[CTR] = (RP.DISP.QTY)
  749.     ISN[CTR] = (ISSUE.NO)
  750.     trim(MN[CTR]|T)
  751.     trim(QU[CTR]|T)
  752.     just(QU[CTR]|L)
  753.     trim(DO[CTR]|T)
  754.     just(DO[CTR]|L)
  755.     trim(DS[CTR]|T)
  756.     just(DS[CTR]|L)
  757.     pmsg(AOD[CTR];" ";MN[CTR];" ";DO[CTR];" ";QU[CTR];" ";DS[CTR];" ";QTY[CTR];" ";ISN[CTR]|||N|N|P|)
  758.     find(N|RP|RETPRINT|)
  759.     if RP.REF <> (RECORD.NUMBER) goto RETPRINT
  760.     CTR = (CTR+1)
  761.     goto TESTALLX
  762. RETPRINT:
  763.     PROC_REF = (RECORD.NUMBER)
  764.     find(M|PROC_REF|RETPRINTX|)
  765.     for(CTR2|1|6|1)
  766.         {
  767.         if PROC[CTR2] = ("") goto RETPRINTX
  768.         pmsg(PROC_DATE[CTR2];"   ";PROC[CTR2]|||N|N|P|)
  769.         fld_lctr = (fld_lctr+1)
  770.         }
  771. RETPRINTX:
  772.     ret
  773. STARTALLXX:
  774.     if RECORD.NUMBER = (0) goto ENDITXXX
  775.     COD.REF = (RECORD.NUMBER)
  776.     find(M|COD.REF|NEXTALL2XX|)
  777.     MEM_RECD = (COD.D[4])
  778.     MEM_RECT = (COD.D[6])
  779.     MEM_RECB = (COD.D[9])
  780. NEXTALL2XX:
  781.     RP.REF = (RECORD.NUMBER)
  782.     find(M|RP.REF|ENDITXXX|)
  783.     CTR = (1)
  784. TESTALLOP:
  785.     if CTR = (11) goto ENDITXXX
  786.     AOD[CTR] = (AUTO.ON.DEMAND)
  787.     MN[CTR] = (MEDICATION)
  788.     DO[CTR] = (DOSE)
  789.     QU[CTR] = (QUANTITY)
  790.     DS[CTR] = (DIRECTIONS)
  791.     QTY[CTR] = (RP.DISP.QTY)
  792.     ISN[CTR] = (ISSUE.NO)
  793.     trim(MN[CTR]|T)
  794.     trim(QU[CTR]|T)
  795.     just(QU[CTR]|L)
  796.     trim(DO[CTR]|T)
  797.     just(DO[CTR]|L)
  798.     trim(DS[CTR]|T)
  799.     just(DS[CTR]|L)
  800.     CTR2 = (CTR+11)
  801.     pmsg(AOD[CTR];" ";MN[CTR];" ";DO[CTR];" ";QU[CTR];" ";DS[CTR];" ";QTY[CTR];" ";ISN[CTR]|1|CTR2|N|N|S|)
  802.     silly = ("")
  803.     find(N|RP|ENDITXXX|)
  804.     if RP.REF <> (RECORD.NUMBER) goto ENDITXXX
  805.     CTR = (CTR+1)
  806.     goto TESTALLOP
  807. ENDITXXX:
  808.     ret
  809. ALC_HLP:
  810.     MESSAGE[1] = ("ENTER NUMBER OF PINTS A WEEK - 1 PUB GIN=1/2 PINT")
  811.     NUM.MSG = (1)
  812.     gosub PRT.MSG
  813.     ret
  814. ANG_HLP:
  815.     MESSAGE[1] = ("ENTER NUMBER OF ATTACKS PER WEEK")
  816.     NUM.MSG = (1)
  817.     gosub PRT.MSG
  818.     ret
  819. WEIGHT:
  820.     MESSAGE[1] = ("THERE IS AN OBESITY PROBLEM HERE")
  821.     NUM.MSG = (1)
  822.     gosub PRT.MSG
  823.     ret
  824. OED_HLP:
  825.     MESSAGE[1] = ("Graded from 0 to 3")
  826.     NUM.MSG = (1)
  827.     gosub PRT.MSG
  828.     ret
  829. FAST:
  830.     MESSAGE[1] = ("Pulse is too fast - REFER")
  831.     NUM.MSG = (1)
  832.     gosub PRT.MSG
  833.     REF_CHECK = ("Y")
  834.     ret
  835. SLOW:
  836.     MESSAGE[1] = ("Pulse is too slow - do DIGOXIN level and Refer")
  837.     NUM.MSG = (1)
  838.     gosub PRT.MSG
  839.     REF_CHECK = ("Y")
  840.     ret
  841. FEV_HLP:
  842.     MESSAGE[1] = ("Enter ideal Fev based on age /wt/ht Program will calculate control as:-")
  843.     MESSAGE[2] = ("1 -Good Fev > 80%  2 - Moderate Fev 50-80%  3- Poor Fev < 30-50%")
  844.     MESSAGE[3] = ("If fev < 30% use Nebuliser and re-test. Refer if 30% or less")
  845.     NUM.MSG = (3)
  846.     gosub PRT.MSG
  847.     ret
  848. \STNEW     
  849.  
  850.  
  851.  
  852.  
  853.  
  854.                                  PROCEDURE ENTRY
  855.           ╔═══════════════════════════════════════════════════════════════╗
  856.           ║ &                          <&                     <&         <║
  857.           ║                                                               ║
  858.           ║  Date             Procedure                        Dr Rec Done║
  859.           ║ &         &                                        & &    &   ║
  860.           ║ &         &                                        & &    &   ║
  861.           ║ &         &                                        & &    &   ║
  862.           ║ &         &                                        & &    &   ║
  863.           ║ &         &                                        & &    &   ║
  864.           ║ &         &                                        & &    &   ║
  865.           ╚═══════════════════════════════════════════════════════════════╝
  866.           Esc - Exit and Save V=1 G=2 P=3 N=4 T=5 * for clinic,xray,path
  867.               Y=DONE S=SEE DR C=COL.SCRPT R=REPEAT O=OTHER N=NORMAL
  868.  
  869.  
  870.  
  871.  
  872.  
  873. \
  874. PATIENT.NAME
  875. ADDRESS1
  876. DATE.OF.BIRTH
  877. PROC_DATE[1]
  878. PROC[1]
  879. PROC_DOC[1]
  880. PROC_OP[1]
  881. PROC_DONE[1]
  882. PROC_DATE[2]
  883. PROC[2]
  884. PROC_DOC[2]
  885. PROC_OP[2]
  886. PROC_DONE[2]
  887. PROC_DATE[3]
  888. PROC[3]
  889. PROC_DOC[3]
  890. PROC_OP[3]
  891. PROC_DONE[3]
  892. PROC_DATE[4]
  893. PROC[4]
  894. PROC_DOC[4]
  895. PROC_OP[4]
  896. PROC_DONE[4]
  897. PROC_DATE[5]
  898. PROC[5]
  899. PROC_DOC[5]
  900. PROC_OP[5]
  901. PROC_DONE[5]
  902. PROC_DATE[6]
  903. PROC[6]
  904. PROC_DOC[6]
  905. PROC_OP[6]
  906. PROC_DONE[6]
  907. \
  908. \R CHKREP  
  909. STOP SMOKING CLINIC:  &                          :&          ON &        BY &      Dr.&
  910. ================================================================================================================
  911. Smokes :&    Exrcise:&    Alcohol:&    Angina:&    Diet:&   Weight:&        Height:&       Ideal Wt:&
  912. Protein:&      Sugar:&       Drs. Rec. BP:&  /&    BP Chk Num:&  BP:&  /&     Standing Sys:&     Pulse:&  /&/&
  913. Fev:&   Ideal Fev:&      control:&
  914. Drugs Checked:&              Next Check:&
  915. Nurses comments:&                              &                               Nurses Sig:
  916.  
  917.  
  918.  
  919.  
  920.  
  921.  
  922.  
  923.  
  924.  
  925.  
  926.  
  927.  
  928.  
  929.  
  930.  
  931.  
  932.  
  933.  
  934.  
  935.  
  936.  
  937.  
  938.  
  939.  
  940.  
  941.  
  942.  
  943.  
  944.  
  945.  
  946.  
  947.  
  948.  
  949.  
  950.  
  951.  
  952.  
  953.  
  954.  
  955.  
  956.  
  957. \
  958. PATIENT.NAME
  959. DATE.OF.BIRTH
  960. TD
  961. CHECK_OP
  962. CHK_DOC
  963. SMOK
  964. EXERCISE
  965. ALCOHOL
  966. ANGINA
  967. DIET
  968. WT1
  969. WT2
  970. IDEAL_WT
  971. PROT
  972. SUG
  973. DOC_BP1
  974. DOC_BP2
  975. BP_CHECK_NUM
  976. BP1
  977. BP2
  978. BP1S
  979. PULSE
  980. REG
  981. APEX
  982. FEV
  983. SUGAR
  984. DRUG_TYPE
  985. DRUGS_CHECKED
  986. NEXT_CHECK
  987. COMMENT1
  988. COMMENT2
  989. \
  990. \SSSCREEN2 
  991. STOP SMOKING     p p p p p p p p p p p p p p p p p p p p p p p p p p p  p p p p p p p p p p( p p) on  p p p p p p p p by  p p p p p p================
  992. =============================================================== Dr.Num:p p    Referred: p       Nxt
  993.  Chk:p p p p p p p p p         Prnt N/Y:p p                ================================================
  994. =============================== Smokes:p p p     Wt:p p p p p p p    Dr.BP:p p p p/ p p p      Ideal Fev: p p p p p p  
  995.                 Exerc :p p p     Ht:p p p p p p p   Chk.No:p p                  Fev: p p p                     
  996. Alcoh :p p p     IW:p p p p p p p       BP:p p p p/ p p p        Control: p                       Angina:p p p     Pr
  997. :p p p p p     St.Sys:p p p p            Cholest: p p p p p                   Diet  :p p      Su:p p p p p      Pulse
  998. :p p p p:p p:p p p p                                      Com1  :p p p p p p p p p p p p p p p p p p p p p p p p p p p p p p p     Com2:p p
  999.  p p p p p p p p p p p p p p p p p p p p p p p p p p p p p   ================================================================
  1000. ==============                                                                                  
  1001.                                                                                                 
  1002.                                                                                                 
  1003.                                                                                                 
  1004.                                                                                                 
  1005.                                                                                                 
  1006.                                                                                                 
  1007.                                                                                                 
  1008.                                                                                                 
  1009.                                                                                                 
  1010.                                                                                                 
  1011. \
  1012. PATIENT.NAME       27 A 17 1
  1013. DATE.OF.BIRTH      10 D 45 1
  1014. AGE                 2 N 56 1
  1015. CHECK_DATE          8 S 63 1
  1016. CHECK_OP            6 A 75 1
  1017. CHK_DOC             1 N  8 3
  1018. REF_CHECK           1 A 22 3
  1019. NEXT_CHECK          8 S 38 3
  1020. YES.NO              1 A 64 3
  1021. SMOK                2 N  8 5
  1022. WT1                 52N 18 5
  1023. DOC_BP1             3 N 34 5
  1024. DOC_BP2             3 N 38 5
  1025. SUGAR               52N 57 5
  1026. EXERCISE            2 N  8 6
  1027. WT2                 52N 18 6
  1028. BP_CHECK_NUM        1 N 34 6
  1029. FEV                 3 N 57 6
  1030. ALCOHOL             2 N  8 7
  1031. IDEAL_WT            52N 18 7
  1032. BP1                 3 N 34 7
  1033. BP2                 3 N 38 7
  1034. DRUG_TYPE           1 N 57 7
  1035. ANGINA              2 N  8 8
  1036. PROT                4 A 18 8
  1037. BP1S                3 N 34 8
  1038. CHOL                42N 57 8
  1039. DIET                1 A  8 9
  1040. SUG                 32N 18 9
  1041. PULSE               3 N 34 9
  1042. REG                 1 A 38 9
  1043. APEX                3 N 40 9
  1044. COMMENT1           30 A  810
  1045. COMMENT2           30 A 4810
  1046. \
  1047. \STDRUGSCR 
  1048.               Digoxin      B-blockers    Diuretics  Tnt + Ca      Steroids
  1049.    ╔═════════════════════════════════════════════════════════════════════════╗
  1050.    ║CHECK║PULSE + APEX    ║FEV          ║OEDEMA    ║ANGINA       ║Wt.Urine.Bp║
  1051.    ║═════║════════════════║═════════════║══════════║═════════════║═══════════║
  1052.    ║TESTS║DIGOXIN LEVEL   ║U&E          ║U&E       ║NONE         ║U&E        ║
  1053.    ║     ║U & E           ║             ║URIC ACID ║             ║══════════ ║
  1054.    ║     ║                ║             ║BS        ║             ║Face       ║
  1055.    ║═════║════════════════║═════════════║══════════║═════════════║Diabetes   ║
  1056.    ║SIDE ║NAUSEA,VOMIT    ║COLD EXTREMS ║GOUT      ║HEADACHE     ║BP         ║
  1057.    ║     ║DIZZY,COLOR VIS.║             ║          ║             ║Bones      ║
  1058.    ║═════║════════════════║═════════════║══════════║═════════════║═══════════║
  1059.    ║REFER║PULSE >120 <56  ║PULSE <50    ║DYSPNEA+  ║ANGINA WORSE ║Any        ║
  1060.    ║     ║                ║FEV 33% LESS ║          ║             ║           ║
  1061.    ╚═════════════════════════════════════════════════════════════════════════╝
  1062.    Pulse:&  /&/&    Fev:&    Oed:& Angina:&   Com:&
  1063.                Drugs                          Com:&
  1064.  
  1065.  
  1066.  
  1067.  
  1068.  
  1069.  
  1070.  
  1071.  
  1072. \
  1073. PULSE
  1074. REG
  1075. APEX
  1076. FEV
  1077. OEDEMA
  1078. ANGINA
  1079. COMMENT1
  1080. COMMENT2
  1081. \
  1082.